home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / UGPRG.ZIP / DENTHOR / TUT11.DOC < prev    next >
Encoding:
Text File  |  1996-07-27  |  27.2 KB  |  793 lines

  1.                    ╒═══════════════════════════════╕
  2.                    │         W E L C O M E         │
  3.                    │  To the VGA Trainer Program   │ │
  4.                    │              By               │ │
  5.                    │      DENTHOR of ASPHYXIA      │ │ │
  6.                    ╘═══════════════════════════════╛ │ │
  7.                      ────────────────────────────────┘ │
  8.                        ────────────────────────────────┘
  9.  
  10.                            --==[ PART 11 ]==--
  11.  
  12.  
  13.  
  14. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  15. ■ Introduction
  16.  
  17. Hello again everybody!
  18.  
  19. The reason _this_ one is delayed (every single trainer has been so far ;))
  20. is mainly due to a birthday (my 19th), and numerous tests at the
  21. university (ugh!).  But anyway, here it is. The sample program this time
  22. is on cross-fading. The reason for this is that many people have
  23. commented that I should be moving over to a few basic demo effects now
  24. that we have most of the basics of VGA programming.  I was also thinking
  25. of either doing sound in a future version of this trainer, or starting a
  26. separate "ASPHYXIA Sound Tutorial" series. Comments?
  27.  
  28. One major difference between this trainer and previous ones is that I am
  29. including binary files (pictures in this case). This means that it will
  30. not be available in the message bases of selected boards anymore, and it
  31. must be obtained from the file base.  Notice will however be given of
  32. it's existence in the message base.
  33.  
  34. Asphyxia has formalised things a bit, and we now have a few official
  35. distribution sites for all our demos and trainers. If you would like
  36. your BBS to become a distribution site, please email me at
  37. smith9@batis.bis.und.ac.za and I will send you the necessary info.
  38.  
  39.  
  40. If you would like to contact me, or the team, there are many ways you
  41. can do it : 1) Write a message to Grant Smith/Denthor/Asphyxia in private mail
  42.                   on the ASPHYXIA BBS.
  43.             2) Write to Denthor, EzE, Goth, Fubar or Nobody on Connectix.
  44.             3) Write to :  Grant Smith
  45.                            P.O.Box 270 Kloof
  46.                            3640
  47.                            Natal
  48.                            South Africa
  49.             4) Call me (Grant Smith) at (031) 73 2129 (leave a message if you
  50.                   call during varsity). Call +27-31-73-2129 if you call
  51.                   from outside South Africa. (It's YOUR phone bill ;-))
  52.             5) Write to smith9@batis.bis.und.ac.za in E-Mail.
  53.  
  54. NB : If you are a representative of a company or BBS, and want ASPHYXIA
  55.        to do you a demo, leave mail to me; we can discuss it.
  56. NNB : If you have done/attempted a demo, SEND IT TO ME! We are feeling
  57.         quite lonely and want to meet/help out/exchange code with other demo
  58.         groups. What do you have to lose? Leave a message here and we can work
  59.         out how to transfer it. We really want to hear from you!
  60.  
  61.  
  62.  
  63. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  64. ■ What is a "Crossfade"?
  65.  
  66. This is a simple question. When you are watching a TV program, you will
  67. often see one picture on the screen, which slowly fades to a new
  68. picture, with the new picture becoming more and more prominent and the
  69. old one becoming less and less prominent. This is a crossfade. Easy huh?
  70.  
  71. Perhaps, but it is not that easy to code on a computer...
  72.  
  73. In most demos, there is a crossfade of two colors, black and white, for
  74. example : The words 'MYDEMOTEAM' appears in large with letters, then
  75. crossfades to 'PRESENTS' in large white letters.
  76.  
  77. I decided to allow the programmer to have a bit of color to his
  78. crossfade, and the sample program can handle a many color crossfade.
  79.  
  80.  
  81. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  82. ■ How does a crossfade work?
  83.  
  84. Here comes the clever bit.
  85.  
  86. To do a crossfade, we load in two pictures, FROM and TO. Then, for every
  87. pixel in which they are different, put a new pixel in a third screen.
  88.  
  89. For example, wherever there is pixel color 9 on screen 1 and pixel color
  90. 45 on screen 2, put pixel color 1 on the third screen. You then repeat
  91. this for all combinations of pixels on screen one and two, and put the
  92. results into screen 3. Here it is in ascii ...
  93.  
  94.   Screen 1     Screen 2     Screen 3
  95.    .1...        .3...        .1...
  96.    .....        ..2..        ..2..
  97.    ...8.    +   ...1.    =   ...3.
  98.    .1...        ....2        .4..2
  99.  
  100. Note how the values on screen 3 are sequential? We keep a count for
  101. this... The two "2"'s on screen 3 are identical, so we do not use a new
  102. color for it...
  103.  
  104. We also keep to pallettes ... source and dest.
  105.  
  106. For the above example source[1] would be the pallette of 1 in screen 1,
  107. and dest[1] would be the pallette of 3 in screen 2 (Note that screen 1
  108. and screen 2 have different pallettes)
  109.  
  110. When we are finished with the picture, we flip screen 3 to the vga and
  111. do the following : move the pallette from source to dest or vice versa.
  112. Thats it. No fancy screen manipulations for the crossfade, we just
  113. change the pallette. Cool, huh? It also means that you can be doing fun
  114. stuff in the foreground with unused pallette colors without your program
  115. executing at two frames per second ;)
  116.  
  117. The sample program is fully documented, and you shouldn't have a problem
  118. deciphering it... If you ever use this effect in a demo or game, greet
  119. me! :-)
  120.  
  121.  
  122. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  123. ■ Problems with crossfades
  124.  
  125. The main problem with crossfading is this : there may only be 256 colors
  126. on screen 3, in other words, only 256 combinations of colors.  In the
  127. sample program, if you load up two pics with more then 256 combinations,
  128. the program gives an error message and exits to dos. To sort this
  129. problem out, you can do two things : reduce the number of places where
  130. the two pictures intersect, or squeeze down the pallette, using
  131. Autodesk Animators "SQUEEZE" command. This reduces the number of colors
  132. used by the picture, and therefore reduces the number of combinations.
  133. The picture does however lose a bit of quality.
  134.  
  135. The second problem with crossfading is this : It hogs most of the
  136. colors. Whatever you want to do in the foreground, make sure you do it
  137. with as few colors as possible.
  138.  
  139.  
  140. =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  141. ■ In closing
  142.  
  143. So, what do you think? Should I continue with demo effects, or should I
  144. find more basic things to do? Perhaps I should stop and just do sound
  145. coding from now on? It is up to you, so leave me mail.
  146.  
  147. You will notice that the sample program can load in any .CEL files, you
  148. needn't be restricted by the ones I have given you. Try crossfading a
  149. few of your own pictures and see how it turns out. The picture of the
  150. robot was draw by Fubar for our demo Psycho Neurosis, and I then
  151. squeezed down the pallette somewhat in order for the crossfade to work.
  152. The word "ASPHYXIA" was drawn by me, also in Autodesk Animator.
  153.  
  154. Oh well, I had better get this off quickly, today is the last time for
  155. the next few days that I can get on to the Net. I will also be voting
  156. tomorrow! If I see a CNN camera, I'll wave (Thats me, the one on the
  157. left in the red shirt! ;-))  The next trainer will be coming from the
  158. New South Africa (TM)
  159.  
  160. See you next time!
  161.  - Denthor
  162.      - 9:16, 26 April, 1994
  163.  
  164. PS. Does anyone in Holland with net access want to act as a courier
  165. between myself and the Accidental Connection BBS? Please leave me mail
  166. at smith9@batis.bis.und.ac.za ....
  167.  
  168. The following are official ASPHYXIA distribution sites :
  169.  
  170. ╔══════════════════════════╦════════════════╦═════╗
  171. ║BBS Name                  ║Telephone No.   ║Open ║
  172. ╠══════════════════════════╬════════════════╬═════╣
  173. ║ASPHYXIA BBS #1           ║+27-31-765-5312 ║ALL  ║
  174. ║ASPHYXIA BBS #2           ║+27-31-765-6293 ║ALL  ║
  175. ║Connectix BBS             ║+27-31-266-9992 ║ALL  ║
  176. ║POP!                      ║+27-12-661-1257 ║ALL  ║
  177. ║Pure Surf BBS             ║+27-31-561-5943 ║A/H  ║
  178. ║Wasted Image              ║407-838-4525    ║ALL  ║
  179. ╚══════════════════════════╩════════════════╩═════╝
  180.  
  181. Leave me mail if you want to become an official Asphyxia BBS
  182. distribution site.
  183.  
  184. (I will find out the country code for Wasted Image later...)
  185.  
  186. Unit GFX2;
  187.  
  188.  
  189. INTERFACE
  190.  
  191. USES crt;
  192. CONST VGA = $A000;
  193.  
  194. TYPE Virtual = Array [1..64000] of byte;  { The size of our Virtual Screen }
  195.      VirtPtr = ^Virtual;                  { Pointer to the virtual screen }
  196.  
  197. VAR Virscr : VirtPtr;                     { Our first Virtual screen }
  198.     Vaddr  : word;                        { The segment of our virtual screen}
  199.  
  200. Procedure SetMCGA;
  201.    { This procedure gets you into 320x200x256 mode. }
  202. Procedure SetText;
  203.    { This procedure returns you to text mode.  }
  204. Procedure Cls (Where:word;Col : Byte);
  205.    { This clears the screen to the specified color }
  206. Procedure SetUpVirtual;
  207.    { This sets up the memory needed for the virtual screen }
  208. Procedure ShutDown;
  209.    { This frees the memory used by the virtual screen }
  210. procedure flip(source,dest:Word);
  211.    { This copies the entire screen at "source" to destination }
  212. Procedure Pal(Col,R,G,B : Byte);
  213.    { This sets the Red, Green and Blue values of a certain color }
  214. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  215.   { This gets the Red, Green and Blue values of a certain color }
  216. procedure WaitRetrace;
  217.    {  This waits for a vertical retrace to reduce snow on the screen }
  218. Procedure Hline (x1,x2,y:word;col:byte;where:word);
  219.    { This draws a horizontal line from x1 to x2 on line y in color col }
  220. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  221.   { This draws a solid line from a,b to c,d in colour col }
  222. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  223.    { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  224.      in color col }
  225. Function rad (theta : real) : real;
  226.    {  This calculates the degrees of an angle }
  227. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word);
  228.    { This puts a pixel on the screen by writing directly to memory. }
  229. Function Getpixel (X,Y : Integer; where:word) :Byte;
  230.    { This gets the pixel on the screen by reading directly to memory. }
  231. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  232.   { This loads the cel 'filename' into the pointer scrptr }
  233.  
  234.  
  235. IMPLEMENTATION
  236.  
  237. {──────────────────────────────────────────────────────────────────────────}
  238. Procedure SetMCGA;  { This procedure gets you into 320x200x256 mode. }
  239. BEGIN
  240.   asm
  241.      mov        ax,0013h
  242.      int        10h
  243.   end;
  244. END;
  245.  
  246. {──────────────────────────────────────────────────────────────────────────}
  247. Procedure SetText;  { This procedure returns you to text mode.  }
  248. BEGIN
  249.   asm
  250.      mov        ax,0003h
  251.      int        10h
  252.   end;
  253. END;
  254.  
  255. {──────────────────────────────────────────────────────────────────────────}
  256. Procedure Cls (Where:word;Col : Byte); assembler;
  257.    { This clears the screen to the specified color }
  258. asm
  259.    push    es
  260.    mov     cx, 32000;
  261.    mov     es,[where]
  262.    xor     di,di
  263.    mov     al,[col]
  264.    mov     ah,al
  265.    rep     stosw
  266.    pop     es
  267. End;
  268.  
  269. {──────────────────────────────────────────────────────────────────────────}
  270. Procedure SetUpVirtual;
  271.    { This sets up the memory needed for the virtual screen }
  272. BEGIN
  273.   GetMem (VirScr,64000);
  274.   vaddr := seg (virscr^);
  275. END;
  276.  
  277. {──────────────────────────────────────────────────────────────────────────}
  278. Procedure ShutDown;
  279.    { This frees the memory used by the virtual screen }
  280. BEGIN
  281.   FreeMem (VirScr,64000);
  282. END;
  283.  
  284. {──────────────────────────────────────────────────────────────────────────}
  285. procedure flip(source,dest:Word); assembler;
  286.   { This copies the entire screen at "source" to destination }
  287. asm
  288.   push    ds
  289.   mov     ax, [Dest]
  290.   mov     es, ax
  291.   mov     ax, [Source]
  292.   mov     ds, ax
  293.   xor     si, si
  294.   xor     di, di
  295.   mov     cx, 32000
  296.   rep     movsw
  297.   pop     ds
  298. end;
  299.  
  300. {──────────────────────────────────────────────────────────────────────────}
  301. Procedure Pal(Col,R,G,B : Byte); assembler;
  302.   { This sets the Red, Green and Blue values of a certain color }
  303. asm
  304.    mov    dx,3c8h
  305.    mov    al,[col]
  306.    out    dx,al
  307.    inc    dx
  308.    mov    al,[r]
  309.    out    dx,al
  310.    mov    al,[g]
  311.    out    dx,al
  312.    mov    al,[b]
  313.    out    dx,al
  314. end;
  315.  
  316. {──────────────────────────────────────────────────────────────────────────}
  317. Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  318.   { This gets the Red, Green and Blue values of a certain color }
  319. Var
  320.    rr,gg,bb : Byte;
  321. Begin
  322.    asm
  323.       mov    dx,3c7h
  324.       mov    al,col
  325.       out    dx,al
  326.  
  327.       add    dx,2
  328.  
  329.       in     al,dx
  330.       mov    [rr],al
  331.       in     al,dx
  332.       mov    [gg],al
  333.       in     al,dx
  334.       mov    [bb],al
  335.    end;
  336.    r := rr;
  337.    g := gg;
  338.    b := bb;
  339. end;
  340.  
  341. {──────────────────────────────────────────────────────────────────────────}
  342. procedure WaitRetrace; assembler;
  343.   {  This waits for a vertical retrace to reduce snow on the screen }
  344. label
  345.   l1, l2;
  346. asm
  347.     mov dx,3DAh
  348. l1:
  349.     in al,dx
  350.     and al,08h
  351.     jnz l1
  352. l2:
  353.     in al,dx
  354.     and al,08h
  355.     jz  l2
  356. end;
  357.  
  358. {──────────────────────────────────────────────────────────────────────────}
  359. Procedure Hline (x1,x2,y:word;col:byte;where:word); assembler;
  360.   { This draws a horizontal line from x1 to x2 on line y in color col }
  361. asm
  362.   mov   ax,where
  363.   mov   es,ax
  364.   mov   ax,y
  365.   mov   di,ax
  366.   shl   ax,8
  367.   shl   di,6
  368.   add   di,ax
  369.   add   di,x1
  370.  
  371.   mov   al,col
  372.   mov   ah,al
  373.   mov   cx,x2
  374.   sub   cx,x1
  375.   shr   cx,1
  376.   jnc   @start
  377.   stosb
  378. @Start :
  379.   rep   stosw
  380. end;
  381.  
  382. {──────────────────────────────────────────────────────────────────────────}
  383. Procedure Line(a,b,c,d:integer;col:byte;where:word);
  384.   { This draws a solid line from a,b to c,d in colour col }
  385.   function sgn(a:real):integer;
  386.   begin
  387.        if a>0 then sgn:=+1;
  388.        if a<0 then sgn:=-1;
  389.        if a=0 then sgn:=0;
  390.   end;
  391. var i,s,d1x,d1y,d2x,d2y,u,v,m,n:integer;
  392. begin
  393.      u:= c - a;
  394.      v:= d - b;
  395.      d1x:= SGN(u);
  396.      d1y:= SGN(v);
  397.      d2x:= SGN(u);
  398.      d2y:= 0;
  399.      m:= ABS(u);
  400.      n := ABS(v);
  401.      IF NOT (M>N) then
  402.      BEGIN
  403.           d2x := 0 ;
  404.           d2y := SGN(v);
  405.           m := ABS(v);
  406.           n := ABS(u);
  407.      END;
  408.      s := m shr 1;
  409.      FOR i := 0 TO m DO
  410.      BEGIN
  411.           putpixel(a,b,col,where);
  412.           s := s + n;
  413.           IF not (s<m) THEN
  414.           BEGIN
  415.                s := s - m;
  416.                a:= a + d1x;
  417.                b := b + d1y;
  418.           END
  419.           ELSE
  420.           BEGIN
  421.                a := a + d2x;
  422.                b := b + d2y;
  423.           END;
  424.      end;
  425. END;
  426.  
  427.  
  428. {──────────────────────────────────────────────────────────────────────────}
  429. Procedure DrawPoly(x1,y1,x2,y2,x3,y3,x4,y4:integer;color:byte;where:word);
  430.   { This draw a polygon with 4 points at x1,y1 , x2,y2 , x3,y3 , x4,y4
  431.     in color col }
  432. var
  433.   x:integer;
  434.   mny,mxy:integer;
  435.   mnx,mxx,yc:integer;
  436.   mul1,div1,
  437.   mul2,div2,
  438.   mul3,div3,
  439.   mul4,div4:integer;
  440.  
  441. begin
  442.   mny:=y1; mxy:=y1;
  443.   if y2<mny then mny:=y2;
  444.   if y2>mxy then mxy:=y2;
  445.   if y3<mny then mny:=y3;
  446.   if y3>mxy then mxy:=y3;    { Choose the min y mny and max y mxy }
  447.   if y4<mny then mny:=y4;
  448.   if y4>mxy then mxy:=y4;
  449.  
  450.   if mny<0 then mny:=0;
  451.   if mxy>199 then mxy:=199;
  452.   if mny>199 then exit;
  453.   if mxy<0 then exit;        { Verticle range checking }
  454.  
  455.   mul1:=x1-x4; div1:=y1-y4;
  456.   mul2:=x2-x1; div2:=y2-y1;
  457.   mul3:=x3-x2; div3:=y3-y2;
  458.   mul4:=x4-x3; div4:=y4-y3;  { Constansts needed for intersection calc }
  459.  
  460.   for yc:=mny to mxy do
  461.     begin
  462.       mnx:=320;
  463.       mxx:=-1;
  464.       if (y4>=yc) or (y1>=yc) then
  465.         if (y4<=yc) or (y1<=yc) then   { Check that yc is between y1 and y4 }
  466.           if not(y4=y1) then
  467.             begin
  468.               x:=(yc-y4)*mul1 div div1+x4; { Point of intersection on x axis }
  469.               if x<mnx then
  470.                 mnx:=x;
  471.               if x>mxx then
  472.                 mxx:=x;       { Set point as start or end of horiz line }
  473.             end;
  474.       if (y1>=yc) or (y2>=yc) then
  475.         if (y1<=yc) or (y2<=yc) then   { Check that yc is between y1 and y2 }
  476.           if not(y1=y2) then
  477.             begin
  478.               x:=(yc-y1)*mul2 div div2+x1; { Point of intersection on x axis }
  479.               if x<mnx then
  480.                 mnx:=x;
  481.               if x>mxx then
  482.                 mxx:=x;       { Set point as start or end of horiz line }
  483.             end;
  484.       if (y2>=yc) or (y3>=yc) then
  485.         if (y2<=yc) or (y3<=yc) then   { Check that yc is between y2 and y3 }
  486.           if not(y2=y3) then
  487.             begin
  488.               x:=(yc-y2)*mul3 div div3+x2; { Point of intersection on x axis }
  489.               if x<mnx then
  490.                 mnx:=x;
  491.               if x>mxx then
  492.                 mxx:=x;       { Set point as start or end of horiz line }
  493.             end;
  494.       if (y3>=yc) or (y4>=yc) then
  495.         if (y3<=yc) or (y4<=yc) then   { Check that yc is between y3 and y4 }
  496.           if not(y3=y4) then
  497.             begin
  498.               x:=(yc-y3)*mul4 div div4+x3; { Point of intersection on x axis }
  499.               if x<mnx then
  500.                 mnx:=x;
  501.               if x>mxx then
  502.                 mxx:=x;       { Set point as start or end of horiz line }
  503.             end;
  504.       if mnx<0 then
  505.         mnx:=0;
  506.       if mxx>319 then
  507.         mxx:=319;          { Range checking on horizontal line }
  508.       if mnx<=mxx then
  509.         hline (mnx,mxx,yc,color,where);   { Draw the horizontal line }
  510.     end;
  511.   end;
  512.  
  513. {──────────────────────────────────────────────────────────────────────────}
  514. Function rad (theta : real) : real;
  515.   {  This calculates the degrees of an angle }
  516. BEGIN
  517.   rad := theta * pi / 180
  518. END;
  519.  
  520. {──────────────────────────────────────────────────────────────────────────}
  521. Procedure Putpixel (X,Y : Integer; Col : Byte; where:word); assembler;
  522.   { This puts a pixel on the screen by writing directly to memory. }
  523. Asm
  524.   mov     ax,[where]
  525.   mov     es,ax
  526.   mov     bx,[X]
  527.   mov     dx,[Y]
  528.   mov     di,bx
  529.   mov     bx, dx                  {; bx = dx}
  530.   shl     dx, 8
  531.   shl     bx, 6
  532.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  533.   add     di, dx                  {; finalise location}
  534.   mov     al, [Col]
  535.   stosb
  536. End;
  537.  
  538. {──────────────────────────────────────────────────────────────────────────}
  539. Function Getpixel (X,Y : Integer; where:word):byte; assembler;
  540.   { This puts a pixel on the screen by writing directly to memory. }
  541. Asm
  542.   mov     ax,[where]
  543.   mov     es,ax
  544.   mov     bx,[X]
  545.   mov     dx,[Y]
  546.   mov     di,bx
  547.   mov     bx, dx                  {; bx = dx}
  548.   shl     dx, 8
  549.   shl     bx, 6
  550.   add     dx, bx                  {; dx = dx + bx (ie y*320)}
  551.   add     di, dx                  {; finalise location}
  552.   mov     al, es:[di]
  553. End;
  554.  
  555. {──────────────────────────────────────────────────────────────────────────}
  556. Procedure LoadCEL (FileName :  string; ScrPtr : pointer);
  557.   { This loads the cel 'filename' into the pointer scrptr }
  558. var
  559.   Fil : file;
  560.   Buf : array [1..1024] of byte;
  561.   BlocksRead, Count : word;
  562. begin
  563.   assign (Fil, FileName);
  564.   reset (Fil, 1);
  565.   BlockRead (Fil, Buf, 800);    { Read and ignore the 800 byte header }
  566.   Count := 0; BlocksRead := $FFFF;
  567.   while (not eof (Fil)) and (BlocksRead <> 0) do begin
  568.     BlockRead (Fil, mem [seg (ScrPtr^): ofs (ScrPtr^) + Count], 1024, BlocksRead);
  569.     Count := Count + 1024;
  570.   end;
  571.   close (Fil);
  572. end;
  573.  
  574.  
  575.  
  576.  
  577. BEGIN
  578. END.{$X+}
  579. USES GFX2,crt;  { Please use the GFX2 unit from now on! The GFX unit had
  580.                   quite a big bug in it, and less routines... }
  581.  
  582. Type Pallette = Array [0..255,1..3] of byte;
  583.  
  584. VAR source,dest:Pallette;
  585.     VirScr2 : VirtPtr;                     { Our second Virtual screen }
  586.     Vaddr2 : Word;                      { The segment of our 2nd virt. screen}
  587.     dir:boolean;     { Fade up or fade down? }
  588.     loop1:integer;
  589.  
  590. {──────────────────────────────────────────────────────────────────────────}
  591. Procedure LoadCELPal (FileName : String; Var Palette : Pallette);
  592.   { This loads in the pallette of the .CEL file into the variable Palette }
  593. Var
  594.   Fil : file;
  595. Begin
  596.   Assign (Fil, FileName);
  597.   Reset (Fil, 1);
  598.   Seek(Fil,32);
  599.   BlockRead (Fil, Palette, 768);
  600.   Close (Fil);
  601. End;
  602.  
  603.  
  604. {──────────────────────────────────────────────────────────────────────────}
  605. Procedure Init;
  606.   { We get memory for our pointers here }
  607. BEGIN
  608.   fillchar (source,sizeof(source),0);
  609.   fillchar (dest,sizeof(dest),0);
  610.   GetMem (VirScr2,64000);
  611.   vaddr2 := seg (virscr2^);
  612. END;
  613.  
  614. {──────────────────────────────────────────────────────────────────────────}
  615. Procedure SetItUp;
  616.   { We define our third screen here }
  617. VAR loop1,loop2,loop3:integer;
  618.     pal1,pal2:pallette;
  619.     change:boolean;
  620.     where:integer;
  621.     r,g,b,r1,g1,b1:byte;
  622. BEGIN
  623.   cls (vaddr2,0);
  624.  
  625.   For loop1:=0 to 255 do
  626.     pal (loop1,0,0,0);
  627.  
  628.   loadcel ('to.cel',virscr);
  629.   loadcelpal ('to.cel',pal2);
  630.   flip (vaddr,vga);
  631.   loadcel ('from.cel',virscr);
  632.   loadcelpal ('from.cel',pal1);
  633.  
  634.   where:=0;
  635.  
  636.   For loop1:=0 to 319 do
  637.     for loop2:=0 to 199 do BEGIN
  638.       if (getpixel(loop1,loop2,vaddr)<>0) or (getpixel (loop1,loop2,vga)<>0) then BEGIN
  639.         change:=false;
  640.         r:=pal1[getpixel(loop1,loop2,vaddr),1];
  641.         g:=pal1[getpixel(loop1,loop2,vaddr),2];
  642.         b:=pal1[getpixel(loop1,loop2,vaddr),3];
  643.         r1:=pal2[getpixel(loop1,loop2,vga),1];
  644.         g1:=pal2[getpixel(loop1,loop2,vga),2];
  645.         b1:=pal2[getpixel(loop1,loop2,vga),3];
  646.  
  647.         for loop3:=0 to where do
  648.           if (source[loop3,1]=r) and (source[loop3,2]=g) and (source[loop3,3]=b) and
  649.              (dest[loop3,1]=r1) and (dest[loop3,2]=g1) and (dest[loop3,3]=b1) then BEGIN
  650.              putpixel (loop1,loop2,loop3,vaddr2);
  651.              change:=TRUE;
  652.           END;
  653.           { Here we check that this combination hasn't occured before. If it
  654.             has, put the appropriate pixel onto the third screen (vaddr2) }
  655.  
  656.         if not (change) then BEGIN
  657.           inc (where);
  658.           if where=256 then BEGIN
  659.             settext;
  660.             writeln ('Pictures have too many colors! Squeeze then retry!');
  661.             Halt;
  662.             { There were too many combinations of colors. Alter picture and
  663.               then retry }
  664.           END;
  665.           putpixel(loop1,loop2,where,vaddr2);
  666.           source[where,1]:=pal1[getpixel(loop1,loop2,vaddr),1];
  667.           source[where,2]:=pal1[getpixel(loop1,loop2,vaddr),2];
  668.           source[where,3]:=pal1[getpixel(loop1,loop2,vaddr),3];
  669.           dest[where,1]:=pal2[getpixel(loop1,loop2,vga),1];
  670.           dest[where,2]:=pal2[getpixel(loop1,loop2,vga),2];
  671.           dest[where,3]:=pal2[getpixel(loop1,loop2,vga),3];
  672.             { Create a new color and set it's from and to pallette values }
  673.         END;
  674.       END;
  675.     END;
  676.   cls (vga,0);
  677. END;
  678.  
  679. {──────────────────────────────────────────────────────────────────────────}
  680. Procedure Crossfade (direction:boolean;del,farin:word);
  681.   { This fades from one picture to the other in the direction specified
  682.     with a del delay. It crossfades one degree for every value in farin.
  683.     If farin=63, then a complete crossfade occurs }
  684. VAR loop1,loop2:integer;
  685.     temp:pallette;
  686. BEGIN
  687.   if direction then BEGIN
  688.     temp:=source;
  689.     for loop1:=0 to 255 do
  690.       pal (loop1,source[loop1,1],source[loop1,2],source[loop1,3]);
  691.     flip (vaddr2,vga);
  692.     For loop1:=0 to farin do BEGIN
  693.       waitretrace;
  694.       for loop2:=0 to 255 do
  695.         pal (loop2,temp[loop2,1],temp[loop2,2],temp[loop2,3]);
  696.       for loop2:=0 to 255 do BEGIN
  697.         if temp[loop2,1]<dest[loop2,1] then inc (temp[loop2,1]);
  698.         if temp[loop2,1]>dest[loop2,1] then dec (temp[loop2,1]);
  699.         if temp[loop2,2]<dest[loop2,2] then inc (temp[loop2,2]);
  700.         if temp[loop2,2]>dest[loop2,2] then dec (temp[loop2,2]);
  701.         if temp[loop2,3]<dest[loop2,3] then inc (temp[loop2,3]);
  702.         if temp[loop2,3]>dest[loop2,3] then dec (temp[loop2,3]);
  703.           { Move temp (the current pallette) from source to dest }
  704.       END;
  705.       delay (del);
  706.     END;
  707.   END
  708.   else BEGIN
  709.     temp:=dest;
  710.     for loop1:=0 to 255 do
  711.       pal (loop1,dest[loop1,1],dest[loop1,2],dest[loop1,3]);
  712.     flip (vaddr2,vga);
  713.     For loop1:=0 to farin do BEGIN
  714.       waitretrace;
  715.       for loop2:=0 to 255 do
  716.         pal (loop2,temp[loop2,1],temp[loop2,2],temp[loop2,3]);
  717.       for loop2:=0 to 255 do BEGIN
  718.         if temp[loop2,1]<source[loop2,1] then inc (temp[loop2,1]);
  719.         if temp[loop2,1]>source[loop2,1] then dec (temp[loop2,1]);
  720.         if temp[loop2,2]<source[loop2,2] then inc (temp[loop2,2]);
  721.         if temp[loop2,2]>source[loop2,2] then dec (temp[loop2,2]);
  722.         if temp[loop2,3]<source[loop2,3] then inc (temp[loop2,3]);
  723.         if temp[loop2,3]>source[loop2,3] then dec (temp[loop2,3]);
  724.           { Move temp (the current pallette) from dest to source }
  725.       END;
  726.       delay (del);
  727.     END;
  728.   END
  729. END;
  730.  
  731. BEGIN
  732.   clrscr;
  733.   writeln ('Hello there! This trainer program is on cross fading. What will happen');
  734.   writeln ('is this : The program will load in two .CEL files, FROM.CEL and TO.CEL');
  735.   writeln ('into the virtual screen at vaddr and to the VGA screen. The pallettes');
  736.   writeln ('of these two pictures are loaded into pal1 and pal2. Note that you');
  737.   writeln ('could easily rewrite this to load in other types of files if you do');
  738.   writeln ('not own Autodesk Animator to draw your files (The pictures presented');
  739.   writeln ('here were drawn by Fubar, sqeezed by me ;)). A third screen is then');
  740.   Writeln ('generated into vaddr2 (this takes 5-10 seconds on my 386-40). Note');
  741.   writeln ('that you could dump vaddr2 to disk as a file instead of calculating it');
  742.   writeln ('each time...it would be faster and be half the size of the two pictures.');
  743.   Writeln ('The picture will then crossfade between the two. Hit a key and it will');
  744.   writeln ('crossfade halfway and then exit.');
  745.   writeln;
  746.   writeln ('After one particular comment E-Mailed to me, I thought I should just add');
  747.   writeln ('this : I am not an employee of Autodesk, and they do not pay me to promote');
  748.   writeln ('their product. You have no idea how much I wish they would :)  I recieve');
  749.   writeln ('absolutely _nothing_ for writing the trainer...');
  750.   writeln;
  751.   writeln;
  752.   write ('Hit any key to continue ...');
  753.   readkey;
  754.   randomize;
  755.   setupvirtual;
  756.   setmcga;
  757.   init;
  758.   SetItUp;
  759.   for loop1:=0 to 255 do
  760.     pal (loop1,source[loop1,1],source[loop1,2],source[loop1,3]);
  761.   flip (vaddr2,vga);
  762.   delay (3000);
  763.  
  764.   dir:=TRUE;
  765.   while keypressed do readkey;
  766.   repeat
  767.     crossfade(dir,20,63);
  768.     dir:=not (dir);
  769.     delay (1000);
  770.   until keypressed;
  771.   Readkey;
  772.   crossfade(dir,20,20);
  773.   readkey;
  774.   settext;
  775.   Writeln ('All done. This concludes the eleventh sample program in the ASPHYXIA');
  776.   Writeln ('Training series. You may reach DENTHOR under the names of GRANT');
  777.   Writeln ('SMITH/DENTHOR/ASPHYXIA on the ASPHYXIA BBS. I am also an avid');
  778.   Writeln ('Connectix BBS user, and occasionally read RSAProg. E-mail me at :');
  779.   Writeln ('    smith9@batis.bis.und.ac.za');
  780.   Writeln ('The numbers are available in the main text. You may also write to me at:');
  781.   Writeln ('             Grant Smith');
  782.   Writeln ('             P.O. Box 270');
  783.   Writeln ('             Kloof');
  784.   Writeln ('             3640');
  785.   Writeln ('             Natal');
  786.   Writeln ('             South Africa');
  787.   Writeln ('I hope to hear from you soon!');
  788.   Writeln; Writeln;
  789.   Write   ('Hit any key to exit ...');
  790.   readkey;
  791.   shutdown;
  792.   FreeMem (VirScr2,64000);
  793. END.